      SUBROUTINE SETUP
      RETURN
      END
C   HS99
      BLOCK DATA
      INCLUDE 'BLOCO.INC'
      INTEGER I,J
      DATA NAME/'HS99'/
      DATA (X(I),I=1,7)/7*.5D0/
      DATA N/7/ , NH/2/ , NG/14/
      DATA DEL0/1.00D0/ ,TAU0/1.00D-1/ ,TAU/.1D0/
      DATA (GUNIT(1,J),J=3,16)/14*1/,(GUNIT(3,I),I=3,16)/7*1,7*-1/,
     F     (GUNIT(2,I),I=3,16)/1,2,3,4,5,6,7,
     F     1,2,3,4,5,6,7/
     F     ,((GUNIT(I,J),I=1,3),J=0,2)/-1,0,0,-1,0,0,-1,0,0/
      END
      SUBROUTINE EF(X,FX)
      INCLUDE 'FUCO.INC'
      INTEGER I
      DOUBLE PRECISION X(NX),A(8),T(8),R(8),FX
      SAVE A,T
      DATA A/0.D0,2*50.D0,3*75.D0,2*100.D0/
      DATA T/0.D0,25.D0,50.D0,100.D0,150.D0,200.D0,290.D0,380.D0/
      ICF=ICF+1
      R(1)=0.D0
      DO      100      I=2,8
      R(I)=A(I)*(T(I)-T(I-1))*DCOS(X(I-1))+R(I-1)
  100 CONTINUE
      FX=-R(8)**2
      RETURN
      END
      SUBROUTINE EGRADF(X,GRADF)
      INCLUDE 'FUCO.INC'
      INTEGER I
      DOUBLE PRECISION X(NX),GRADF(NX),A(8),T(8),R(8),G(7)
      SAVE A,T
      DATA A/0.D0,2*50.D0,3*75.D0,2*100.D0/
      DATA T/0.D0,25.D0,50.D0,100.D0,150.D0,200.D0,290.D0,380.D0/
      R(1)=0.D0
      ICGF=ICGF+1
      DO      100      I=2,8
      R(I)=A(I)*(T(I)-T(I-1))*DCOS(X(I-1))+R(I-1)
      G(I-1)=-A(I)*(T(I)-T(I-1))*DSIN(X(I-1))
  100 CONTINUE
      DO      200      I=1,7
      GRADF(I)=-2. D0*R(8)*G(I)
 200  CONTINUE
      RETURN
      END
      SUBROUTINE EH(J,X,HXI)
      INCLUDE 'FUCO.INC'
      INTEGER J,I
      DOUBLE PRECISION X(NX),A(8),T(8),S(8),Q(8),HXI,C,B
      SAVE B,T
      DATA B/32.D0/ ,A/0.D0,2*50.D0,3*75.D0,2*100.D0/
      DATA T/0.D0,25.D0,50.D0,100.D0,150.D0,200.D0,290.D0,380.D0/
      CRES(J)=CRES(J)+1
      Q(1)=0.D0
      S(1)=0.D0
      DO      100      I=2,8
      C=(A(I)*DSIN(X(I-1))-B)*(T(I)-T(I-1))
      S(I)=C+S(I-1)
      Q(I)=(C*.5D0+S(I-1))*(T(I)-T(I-1))+Q(I-1)
  100 CONTINUE
      IF(J .EQ. 1)      HXI=(Q(8)-1.D5)
      IF(J .EQ. 2)      HXI=(S(8)-1.D3)
      RETURN
      END
      SUBROUTINE EGRADH(JJ,X,GRADHI)
      INCLUDE 'FUCO.INC'
      INTEGER JJ,J,K
      DOUBLE PRECISION X(NX),GRADHI(NX),A(8),T(8),G1(7),G2(7),C
      SAVE A,T
      DATA A/0.D0,2*50.D0,3*75.D0,2*100.D0/
      DATA T/0.D0,25.D0,50.D0,100.D0,150.D0,200.D0,290.D0,380.D0/
      CGRES(JJ)=CGRES(JJ)+1
      DO      100      J=1,7
      G1(J)=0.D0
      G2(J)=0.D0
  100 CONTINUE
      DO      300      J=2,8
      C=(T(J)-T(J-1))*A(J)*DCOS(X(J-1))
      DO      200      K=1,7
      G1(K)=(T(J)-T(J-1))*G2(K)+G1(K)
  200 CONTINUE
      G1(J-1)=G1(J-1)+.5D0*(T(J)-T(J-1))*C
      G2(J-1)=C+G2(J-1)
  300 CONTINUE
      IF(JJ .EQ. 2)      GOTO 500
      DO      400      J=1,7
      GRADHI(J)=G1(J)
  400 CONTINUE
      RETURN
  500 CONTINUE
      DO      600      J=1,7
      GRADHI(J)=G2(J)
  600 CONTINUE
      RETURN
      END
      SUBROUTINE EG(I,X,GXI)
      INCLUDE 'FUCO.INC'
      INTEGER I
      DOUBLE PRECISION X(NX),GXI
      IF ( GUNIT(1,I+NH) .EQ. -1 ) CRES(I+NH)=CRES(I+NH)+1
      IF(I.LE.7)      GXI=X(I)
      IF(I.GT.7)      GXI=1.58D0-X(I-7)
      END
      SUBROUTINE EGRADG(I,X,GRADGI)
      INCLUDE 'FUCO.INC'
      INTEGER I
      DOUBLE PRECISION X(NX) ,GRADGI(NX)
      RETURN
      END


